home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 21 / Cream of the Crop 21 (Terry Blount) (October 1996).iso / program / slix0987.zip / 2HR8.BAS < prev    next >
BASIC Source File  |  1996-08-10  |  28KB  |  747 lines
  1. DEFINT A-Z
  2.  
  3. '2HR8.BAS
  4. 'Written by Lloyd Chang
  5.  
  6. 'This file is part of slix
  7.  
  8. 'The conditions to use
  9. '2HR8 are the same as those
  10. 'applied to the use of slix.
  11.  
  12. COLOR 7
  13. PRINT
  14. PRINT "2HR8 - BMP/GIF to HR8 converter"
  15. PRINT "Written by Lloyd Chang"
  16. PRINT
  17. PRINT "This could take a while...  :)"
  18. PRINT
  19.  
  20. COLOR 23
  21. PRINT "WORKING"
  22.  
  23. HR8Header$ = "HR8"
  24.  
  25. HR8HeaderSize% = 7
  26.  
  27. RGBPaletteFile% = FREEFILE
  28.  
  29. PaletteRGB$ = SPACE$(768)
  30.  
  31.  
  32. DIM RGBPaletteTranslator(255) AS INTEGER
  33. OPEN "RGB.PAL" FOR BINARY AS #RGBPaletteFile%
  34. GET #RGBPaletteFile%, 1, PaletteRGB$
  35. CLOSE #RGBPaletteFile%
  36.  
  37. FILEXFile% = FREEFILE
  38.  
  39. filename$ = COMMAND$
  40.  
  41. 'Open file for input so QB stops with an error if it doesn't exist.
  42. OPEN filename$ FOR INPUT AS #FILEXFile%
  43. CLOSE #FILEXFile%
  44.  
  45. OPEN filename$ FOR BINARY AS #FILEXFile%
  46.  
  47. FOR Count% = 1 TO LEN(filename$)
  48.   SELECT CASE MID$(filename$, Count%, 1)
  49.     CASE IS = "."
  50.       Outputfile$ = LEFT$(filename$, Count%) + "HR8"
  51.       extension% = 1
  52.   END SELECT
  53. NEXT Count%
  54.  
  55. SELECT CASE extension%
  56.   CASE IS = 1
  57.   CASE ELSE
  58.     Outputfile$ = filename$ + ".HR8"
  59. END SELECT
  60.  
  61. SELECT CASE LOF(FILEXFile%)
  62.   CASE IS > 32
  63.     HeaderTest$ = SPACE$(32)
  64.   CASE ELSE
  65.     HeaderTest$ = SPACE$(LOF(FILEXFile%))
  66. END SELECT
  67.  
  68. GET #FILEXFile%, , HeaderTest$
  69.  
  70. SELECT CASE LEFT$(HeaderTest$, 2)
  71.   CASE IS = "BM"
  72.     HeaderSig% = 2
  73.     HeaderSig$ = "BMPWIN"
  74. END SELECT
  75.  
  76. SELECT CASE LEFT$(HeaderTest$, 3)
  77.   CASE IS = "GIF"
  78.     HeaderSig% = 3
  79.     HeaderSig$ = "GIF"
  80. END SELECT
  81.  
  82. SELECT CASE HeaderSig$
  83.   CASE IS = "BMPWIN"
  84.     Outputfile% = FREEFILE
  85.     OPEN Outputfile$ FOR BINARY AS #Outputfile%
  86.     header$ = SPACE$(14)
  87.     sizing$ = SPACE$(4)
  88.     GET #FILEXFile%, 1, header$
  89.     GET #FILEXFile%, 15, sizing$
  90.     bmpinfosize = CVI(sizing$)
  91.     'bmpinfosize - Is the size of the information header for the bitmap.
  92.     '              Different bitmap versions have variations in filetypes.
  93.     '              40 is a standard windows 3.1 bitmap.
  94.     '              12 is for OS/2 bitmaps
  95.     'The next routine reads in the appropriate headers and colour tables.
  96.     'nbits is the number of bits per pixel - i.e. number of colours
  97.     '1 bit = 2 colours, 4 bits = 16 colours, 8 bits = 256 colours, etc.
  98.     'the 24 bit mode does not have a palette, its colours are expressed as
  99.     'image data
  100.  
  101.     'Design of a windows 3.1 bitmap - Taken from bmp.zip on the
  102.     'x2ftp.oulu.fi ftp site under /pub/msdos/programming/formats
  103.     'Specifications for a Windows 3.1 bitmap. (.BMP)
  104.     'Email any questions/responses to me at zabudsk@ecf.utoronto.ca
  105.     'or post to alt.lang.basic or comp.lang.basic.misc.
  106.  
  107.     '       | # of   |
  108.     'Offset | bytes  | Function (value)
  109.     '-------+--------+--- General Picture information starts here---------
  110.     '  0    |   2    | (BM) - Tells us that the picture is in bmp format
  111.     '  2    |   4    | Size of the file (without header?)
  112.     '  6    |   2    | (0) Reserved1 - Must be zero
  113.     '  8    |   2    | (0) Reserved2 - Must be zero
  114.     '  10   |   4    | Number of bytes offset of the picture data
  115.     '-------+--------+--- Information Header starts here -----------------
  116.     '  14   |   4    | (40/12) Size of information header (Win3.1/OS2)
  117.     '  18   |   4    | Picture width in pixels
  118.     '  22   |   4    | Picture Height in pixels
  119.     '  26   |   2    | (1) Number of planes, must be 1
  120.     '  28   |   2    | Number of bits per pixel (bpp), must be 1,4,8 or 24
  121.     '  30   |   4    | (0) Compression - 0 means no compression, 1,2 are RLEs
  122.     '  34   |   4    | Image size in bytes
  123.     '  38   |   4    | picture width in pels per metre
  124.     '  42   |   4    | picture height in pels per metre
  125.     '  46   |   4    | (0) Number of colours used in the picture, 0 means all
  126.     '  50   |   4    | (0) Number of important colours, 0 means all
  127.     '-------+--------+--- Palette data starts here -----------------------
  128.     '  54   |   1    | (b) - blue intensity component, color 0 - range 0 to 255
  129.     '  55   |   1    | (g) - green intensity component, color 0 - range 0 to 255
  130.     '  56   |   1    | (r) - red intensity component, color 0 - range 0 to 255
  131.     '  57   |   1    | (0) - unused
  132.     '  58   |   1    | (b) - blue intensity component, color 0 - range 0 to 255
  133.     '  ...  | ...    |
  134.     '  54   | 4*2^bpp| total range of palette
  135.     '-------+--------+--- Image data starts here -------------------------
  136.     '54+    | width* | Bitmap data starting at lower left portion of the
  137.     '(4*2^n)| height*| image moving from left towards right. Moving up 1
  138.     '       | (8/bpp)| pixel when at the right hand side of the image, starting
  139.     '       |        | from the left side again, until the top right of the
  140.     '       |        | image is reached
  141.  
  142.     'Note that this format is slightly different for a OS/2 Bitmap.
  143.     'The header is the same up to (but not including) bit 30-
  144.     'The palette colour values follow at bit 30, with the form...
  145.     '1 byte blue intensity
  146.     '1 byte green intensity
  147.     '1 byte red intensity
  148.     'For each colour of the picture.
  149.     'Bitmapped image data follows the colour tables
  150.  
  151.  
  152.     'Special note: When storing 1 bit (2 colour) pictures.
  153.     '8 horizontal pixels are packed into 1 byte. Each bit determines
  154.     'the colour of one pixel (colour 0 or colour 1)
  155.  
  156.     '4 bit pictures (16 colours) use 2 nibbles (4 bits) for each pixel
  157.     'thus there are 2 pixels for each byte of image data.
  158.  
  159.     '8 bit pictures use 1 byte per pixel. Each byte of image data
  160.     'represents one of 256 colours.
  161.  
  162.     '24 bit pictures express colour values by using 3 bytes and each has a
  163.     'value between 0 and 255. The first byte is for red, the second is for
  164.     'green and the third is for blue. Thus (256)^3 or 2^24 of 16777216 different
  165.     'colours.
  166.  
  167.     IF bmpinfosize = 12 THEN
  168.        infoheader$ = SPACE$(12)
  169.        GET #FILEXFile%, 15, infoheader$
  170.        nbits = CVI(MID$(infoheader$, 15, 4))
  171.  
  172.        IF nbits = 1 THEN
  173.           palet$ = SPACE$(6)
  174.           GET #FILEXFile%, bmpinfosize + 15, palet$
  175.        ELSEIF nbits = 4 THEN
  176.           palet$ = SPACE$(48)
  177.           GET #FILEXFile%, bmpinfosize + 15, palet$
  178.        ELSEIF nbits = 8 THEN
  179.           palet$ = SPACE$(768)
  180.           GET #FILEXFile%, bmpinfosize + 15, palet$
  181.        END IF
  182.     ELSEIF bmpinfosize = 40 THEN
  183.        infoheader$ = SPACE$(40)
  184.        GET #FILEXFile%, 15, infoheader$
  185.        nbits = CVI(MID$(infoheader$, 15, 4))
  186.        IF nbits = 1 THEN
  187.           palet$ = SPACE$(8)
  188.           GET #FILEXFile%, bmpinfosize + 15, palet$
  189.        ELSEIF nbits = 4 THEN
  190.           palet$ = SPACE$(64)
  191.           GET #FILEXFile%, bmpinfosize + 15, palet$
  192.        ELSEIF nbits = 8 THEN
  193.           palet$ = SPACE$(1024)
  194.           GET #FILEXFile%, bmpinfosize + 15, palet$
  195.        END IF
  196.     END IF
  197.    
  198.  
  199.     ft$ = MID$(header$, 1, 2)
  200.     'PRINT "Type of file (Should be BM): "; ft$
  201.  
  202.     filesize& = CVL(MID$(header$, 3, 4))
  203.     'PRINT "Size of file: "; filesize&
  204.  
  205.     r1 = CVI(MID$(header$, 7, 2))
  206.     'PRINT "Reserved 1: "; r1
  207.  
  208.     r2 = CVI(MID$(header$, 9, 2))
  209.     'PRINT "Reserved 2: "; r2
  210.  
  211.     offset = CVL(MID$(header$, 11, 4))
  212.     'PRINT "Number of bytes offset from beginning: "; offset
  213.  
  214.     'PRINT
  215.  
  216.     headersize = CVL(MID$(infoheader$, 1, 4))
  217.     'PRINT "Size of header: "; headersize
  218.  
  219.     PicWidth = CVL(MID$(infoheader$, 5, 4))
  220.     'PRINT "Width: "; picwidth
  221.  
  222.     PicHeight = CVL(MID$(infoheader$, 9, 4))
  223.     'PRINT "Height: "; picheight
  224.  
  225.     HeaderXSize1$ = CHR$(PicWidth \ 256)
  226.     HeaderXSize2$ = CHR$(PicWidth MOD 256)
  227.     HeaderYSize1$ = CHR$(PicHeight \ 256)
  228.     HeaderYSize2$ = CHR$(PicHeight MOD 256)
  229.     PUT #Outputfile%, 1, HR8Header$
  230.     PUT #Outputfile%, , HeaderXSize1$
  231.     PUT #Outputfile%, , HeaderXSize2$
  232.     PUT #Outputfile%, , HeaderYSize1$
  233.     PUT #Outputfile%, , HeaderYSize2$
  234.     FileNoHeaderCount& = 0
  235.  
  236.     nplanes = CVI(MID$(infoheader$, 13, 4))
  237.     'PRINT "Planes: "; nplanes
  238.  
  239.     'PRINT "Bits per plane: "; nbits
  240.  
  241.     'PRINT
  242.  
  243.     IF headersize = 40 THEN
  244.        'PRINT "Compression: ";
  245.        comptype = CVL(